perm filename M.F4[PAG,LCS] blob
sn#598971 filedate 1981-07-12 generic text, type T, neo UTF8
01300 SUBROUTINE SLRV(KK,C)
01350 COMMON /Q/Q(1)
01400 Q(KK+4)=C+Q(KK+4)
01500 Q(KK+5)=C+Q(KK+5)
01550 C ADD NUM. TO HEIGHT PARAMETERS
01600 Q(KK+7)=-Q(KK+7)
01700 C INVERT THE SLUR
01800 END
02000
02200 FUNCTION CLEFN(Q,J)
02250 DIMENSION Q(1)
02300 CLEFN=0
02400 IF(Q(J).LT.3.)RETURN
02500 CLEFN=Q(J+5)
02600 END
03300
03400 SUBROUTINE MMNN(K)
03450 COMMON /JN/J,N /XRN/MM(500),NN(1)
03500 N=N+1
03900 IF(K.NE.3)NN(N)=-1
03950 C FOR SECONDARY POSITIONS.
04100 MM(N)=J+K
04200 END
04400
04500 FUNCTION CODEN(K,N,R,M)
04600 DIMENSION K(1),R(1)
04700 M=K(N)
04800 CODEN=R(M+1)
04900 C GET THE CODE NUMBER AND SAVE THE POINTER IN M.
05000 END
05400
05500 FUNCTION ZERO(X,Y)
05600 ZERO=X-Y
05800 CC IF(ABS(ZERO).LE..01)ZERO=0
05900 IF(ZERO.LT.0)ZERO=-ZERO
05950 IF(ZERO.LE..01)ZERO=0
06000 END
06300
06400 C DO NEXT IF MORE THAN 1 STAFF(KPG) AND DIFF. SIZE FACTORS ARE FOUND.
06500 SUBROUTINE BARFAC(KPG,BFAC,JK)
06525 COMMON /STF/RSTFAC(8) /XRN/RN(1) /PX/KPN(1) /Q/Q(1) /JN/J
06550 R=RSTFAC(1)
06600 DO 5112 K=2,KPG
06800 5112 IF(R.NE.RSTFAC(K))GO TO 6112
07200 RETURN
07400 C NEXT TO FIND PROBABLE SIZE FACTOR FOR THIS BAR. (NOT FOR PARTS)
07500 C FIND LINE WITH MOST ACTIVITY.
07600 C ALL THIS SORT OF WORKS. SOMEDAY REVIEW IT.********
07700 6112 DO 1112 K=1,8
07900 1112 RN(K)=0
08000 DO 112 K=JK,J-1
08400 JD=KPN(K)
08500 R=Q(JD+1)
08900 IF(R.GT.3.)GO TO 112
09100 A=1.0
09200 C CHECKS FOR NUMBER OF NOTES, RESTS, CLEFS.
09300 IF(R.EQ.2)A=0.6
09400 C SKIP NON-RHYTHM CHORD NOTES. RESTS ARE CONSIDERED LESS IMPORTANT.
09600 IF(R.NE.1)GO TO 4112
09800 IF(Q(JD).LT.7)GO TO 112
09900 IF(Q(JD+9).LE.0)GO TO 112
10100 4112 LF=Q(JD+2)+1
10200 RN(LF)=RN(LF)+A
10300 112 CONTINUE
10600 JD=1
10700 B=RN(1)*RSTFAC(1)
10900 DO 2112 K=2,KPG
11000 A=RN(K)*RSTFAC(K)
11200 IF(A.LE.B)GO TO 2112
11400 JD=K
11500 B=A
11600 2112 CONTINUE
11900 BFAC=BFAC*(RSTFAC(JD)+.1)
12000 C +.1 ABOVE TO MINIMIZE DIFF. IN SIZE FACTOR.
12200 END